{
Traviesadora beta 0.2.0.13.33 (30.11.2008)
LastMod: 20.03.2009 by Prof1983

Copyright 2008, travieorama@googlemail.com

This file is part of the taviesadora project

taviesadora is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation; either version 2 of the License, or
(at your option) any later version.

taviesadora is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
GNU General Public License for more details.
}
unit CryptoLayer;

interface

uses
  Classes, Dialogs, SysUtils, ExtCtrls, Windows, Forms, ShellApi, Service, DH,
  LbCipher, LbClass, LbAsym, LbDSA, LbUtils,
  ChatDistributer, CryptFunctions, CryptKeyLibrary, CryptQestion, RosterGlobals;

const
  BLOCK_RESET_TIME = 30000; //30sec
  START_TIMEOUT = 20000; //30sec
  KEY_STRENGTH_ROUNDS = 10000;
  KEYCHANGE_INTERVAL = ((0*60)+40); //
  RANDSEED_ENTROPY_SIZE = 100;
type
  TCryptStateBaseProt=(csNone,csStart,csProtocollStarted);
  TCryptStateAuthProt1=(cs1none,cs1DHing,cs1DHEncry,cs1SKDBStateSent,cs1AuthQuestionSent,cs1SKGenerated,cs1SKEstablished);
  TCryptStateDHProt1=(cs1DHNone,cs1DHPubdhKeySent,cs1dhKeyGenerated);
  TProtLevel=(plAll,pljustProt1);
  PChatItem =  ^TChatItem;

  TCryptLayer = class
  private
    ChatList: TList;
    KeyLibjabber: TCryptKeyLib;
    KeyLibNobra: TCryptKeyLib;
    jid: string;
    nid: string;

    function SearchChat(Chat: TChatDistri): Integer;
    procedure Clear;
    procedure Del(i: Integer);
    function Add(chatDistri: TChatDistri; AsInitiator: Boolean): PChatItem;
    function SupportedVersions: string;
    procedure SendStart(ch: PChatItem);
    procedure SendIChoose(ch: PChatItem; Param2: string);
    function ChooseVersion(Versions: string): string;
    procedure TestDH;
    procedure cbTmrSendaIChoose(Sender: TObject);
    procedure cbTmrSendaStart(Sender: TObject);
    procedure cbtmrStartTimeOut(Sender: TObject);
  public
    constructor Create(jid, nid: string; IniFile: TConfigFile);
    destructor Destroy; override;
    function LoadKeyLib(PW: string): Boolean;
    procedure RegisterChatDistri(ChatDistri: TChatDistri; AsInitiator{,wannacrypt}: Boolean);
    procedure UnRegisterChatDistri(ChatDistri: TChatDistri);
    function NewInMessage(msg: string; ChatDistri: TChatDistri): string;
    function NewOutMessage(msg: string; ChatDistri: TChatDistri): string;
    procedure SetToWantedCrypt(CryptState: TCryptState; ChatDistri: TChatDistri);
    procedure PartnerGotOffline(ChatDistri: TChatDistri);
    function getKeyLibRecords(): string;
    procedure DeleteKeyLibRecords(Extra, PartnerID: string);
    procedure SetKeyLibPW(PW: string);
  end;

  TCryptProtocol = class(TObject)
  private
    Layer: TCryptLayer;
    chat: TChatDistri;
    IsInitiator: Boolean;
    KeyLib: TCryptKeyLib;
  public
    constructor Create(Layer: TCryptLayer; Chat: TChatDistri; IsInitiator: Boolean; KeyLib: TCryptKeyLib);
    destructor Destroy(); override;
    function NewInMessage(msg: string; ch: PChatItem): string;
    function NewOutMessage(msg: string; ch: PChatItem): string;
    procedure SetToWantedCrypt(CryptState: TCryptState);
    procedure PartnerGotOffline();
  end;

  TCryptProtocollVersion1 = class(TCryptProtocol)
  private
    AuthState: TCryptStateAuthProt1;
    DHState: TCryptStateDHProt1;
    SessionID: Integer;
    KeyChangetimer: TTimer;
    LbRijndael: TLbRijndael;
    CipherWithAuth: Boolean;
    ForceToStrongAuth: Boolean;
    AskedQuestion: string;
    cryptques: Tfrm_CryptQuestion;
    justSentCntrlMsg: Boolean;
    DHpParam,DHgParam: string;
    keyChangeRunningTime: Integer;
    SendAfterKeyChanged: string;
    DHResult:array[0..(KeySizeProt1 div 8)-1]of Char;
    MyDHKey: array[0..(KeySizeProt1 div 8)-1]of Char;
    procedure cbKeyChange(Sender: TObject);
    procedure NewSessionAndSentPublicData(SendwithGandP: Boolean; g, p: string);
    procedure GenerateDHKey(PubKey: string);
    procedure GenerateSKKey(SessionKey: string);
    function MakeProtMsg(msg: string; level: TProtLevel): string;
    function Decrypt(msg: string): string;
    function Encrypt(msg: string): string;
    procedure SendSKState;
    function Do_cs1SKDBStateSent(res, param1, param2: string): string;
    procedure resettodh();
    procedure GoToAuthMode();
    procedure ProcessDHExchange(msg: string);
    procedure sendCntrMsg(msg: string);
    procedure KeyChange();
  public
    constructor Create(Layer: TCryptLayer; Chat: TChatDistri; IsInitiator: Boolean; KeyLib: TCryptKeyLib);
    destructor Destroy; override;
    function NewInMessage(msg: string; ch: PChatItem): string;
    function NewOutMessage(msg: string; ch: PChatItem): string;
    procedure SetSecretAnswerMD5(secretAnswer: string);
    function KeyStrength(weakkey: string): string;
    procedure SendQuestion(Question: string);
    procedure UnregisterCryptQuesWindow();
    procedure GoToCryptState(WantedState: TCryptState);
    procedure PartnerGotOffline();
  end;

  TChatItem = record
    Chat: TChatDistri;
    protocoll: TCryptProtocol;
    tmrWaitWithConnectionReset: TTimer;
    tmrStartTimeOut: TTimer;
    state: TCryptStateBaseProt;
    Initiator: Boolean;
    Param2: string;    //we use this if there attemps to reset the connection within a short time. Then we reest the connection later. For this we may need this variable
    ConnectionBirthTime: Cardinal;
  end;

implementation

{ TCryptLayer }

function TCryptLayer.LoadKeyLib(PW: string): Boolean;
begin         //result = true if no error
  result := not (not KeyLibjabber.LoadKeyLib(PW) or
            not KeyLibNobra.LoadKeyLib(PW));
end;

constructor TCryptLayer.create(jid, nid: string; IniFile: TConfigFile);
var
  a: Integer;
  //b: Integer;
  //msg: string;
  //buffer: array[0..6]of Char;
  rand_ini_entropy: array[0..RANDSEED_ENTROPY_SIZE-1] of Byte;
begin
  inherited Create;

  ChatList := TList.Create;
  Randomize;
  for a := 0 to High(rand_ini_entropy) do
  begin
    rand_ini_entropy[a] := Random(255);
  end;
 // SetCurrentDirectory(PCHAR(extractfilepath(application.exename)+'dh\'));
  DH_InitDLL(@rand_ini_entropy[0],RANDSEED_ENTROPY_SIZE);
  //TestDH;
//  msg := KeyStrength('hallo');
//  if msg='' then begin end;
  self.jid := jid;
  self.nid := nid;
  KeyLibjabber := TCryptKeyLib.create(jid,ExtractFilePath(Application.ExeName)+'cache\'+inifile.GetLastusedProfile+'\Keyjabber.txt',inifile);
  KeyLibNobra := TCryptKeyLib.create(nid,ExtractFilePath(Application.ExeName)+'cache\'+inifile.GetLastusedProfile+'\KeyNobraNet.txt',inifile);
end;

destructor TCryptLayer.Destroy();
begin
  Clear;
  FreeAndNil(ChatList);
  FreeAndNil(KeyLibjabber);
  FreeAndNil(KeyLibNobra);
  inherited Destroy;
end;

function TCryptLayer.SearchChat(Chat: TChatDistri): Integer;
var
  i: Integer;
  ch: PChatItem;
begin
  result := -1;
  for i := 0 to ChatList.Count-1 do
  begin
    ch := ChatList[i];
    if ch.Chat = Chat then
    begin
      result := i;
      Break;
    end;
  end;
end;

procedure TCryptLayer.Del(i: integer);
var
  ch: PChatItem;
begin
  if (i > -1) and (i<ChatList.Count) then
  begin
    ch := ChatList[i];
    if ch.protocoll <> nil then
    begin
      if ch.protocoll is TCryptProtocollVersion1 then
        (ch.protocoll as TCryptProtocollVersion1).destroy;
    end;
    ch.tmrWaitWithConnectionReset.Free;
    ch.tmrStartTimeOut.Free;
    dispose(ch);
    ChatList.delete(i);
  end;
end;

procedure TCryptLayer.Clear;
var
  i:integer;
begin
  for i := 0 to ChatList.Count-1 do
  begin
    del(0);
  end;
end;

function TCryptLayer.Add(chatDistri: TchatDistri; AsInitiator: boolean):PChatItem;
var
  i: Integer;
  ch: PChatItem;
begin
  i := SearchChat(chatDistri);
  if (i < 0) then
  begin
    new(ch);
    ch.Chat := chatDistri;
    ch.tmrWaitWithConnectionReset := TTimer.Create(nil);
    ch.tmrWaitWithConnectionReset.Tag := ChatList.Count;
    ch.tmrStartTimeOut := TTimer.Create(nil);
    ch.tmrStartTimeOut.Enabled := false;
    ch.tmrStartTimeOut.Tag := ChatList.Count;
    ch.tmrStartTimeOut.OnTimer := cbtmrStartTimeOut;
    ch.tmrStartTimeOut.Interval := START_TIMEOUT;
    ch.state := csNone;
    ch.Initiator := AsInitiator;
    ch.protocoll := nil;
    ch.ConnectionBirthTime := 0;
    ChatList.Add(ch);
    result := ch;
  end
  else
    result := ChatList[i];
end;

procedure TCryptLayer.RegisterChatDistri(chatDistri: TchatDistri;AsInitiator{,wannacrypt}:boolean);
var
  ch: PChatItem;
begin
  ch := add(chatDistri,AsInitiator);
  if nid <> chatDistri.GetRmtNick then
    if AsInitiator and chatDistri.PartnerCanEncryption and chatDistri.PartnerIsOnline then
      SendStart(ch);
end;

procedure TCryptLayer.UnRegisterChatDistri(chatDistri: TchatDistri);
begin
  if ChatList <> nil then
    del(SearchChat(chatDistri));
end;

procedure TCryptLayer.cbTmrSendaStart(Sender: TObject);
var
  ch: PChatItem;
begin
  ch := ChatList[(Sender as TTimer).tag];
  (sender as TTimer).Enabled := false;
  SendStart(ch);
end;

procedure TCryptLayer.cbTmrSendaIChoose(Sender: TObject);
var
  ch: PChatItem;
begin
  ch := ChatList[(Sender as TTimer).tag];
  (sender as TTimer).Enabled := false;
  SendIChoose(ch,ch.Param2);
end;

procedure TCryptLayer.cbtmrStartTimeOut(Sender: TObject);
var
  ch: PChatItem;
begin
  ch := ChatList[(Sender as TTimer).tag];
  (sender as TTimer).Enabled := false;
  if ch.state = csStart then
  begin
    ch.state := csNone;
    ch.Chat.SetCryptState(csNoEncryption);
  end;
end;

procedure TCryptLayer.SendStart(ch: PChatItem);
begin
  if Assigned(ch) then
  begin
    if Gettickcount-ch.ConnectionBirthTime > BLOCK_RESET_TIME then begin     //avoid too many reset requests     (denial of service)
      ch.Chat.SendMessage('{crypt}start'+sep+SupportedVersions,nil);
      ch.Chat.SetCryptState(csInitialising);
      ch.state := csStart;
      ch.ConnectionBirthTime := Gettickcount;
      ch.tmrStartTimeOut.Enabled := true;
    end else begin
      ch.tmrWaitWithConnectionReset.Interval := BLOCK_RESET_TIME+1000-(Gettickcount-ch.ConnectionBirthTime);
      ch.tmrWaitWithConnectionReset.OnTimer := cbTmrSendaStart;
      ch.tmrWaitWithConnectionReset.Enabled := true;
    end;
  end;
end;

procedure TCryptLayer.SendIChoose(ch: PChatItem;param2:string);
begin
  if ch <> nil then begin
    if Gettickcount-ch.ConnectionBirthTime > BLOCK_RESET_TIME then begin
      param2 := ChooseVersion(param2);
      ch.Chat.SendMessage('{crypt}i_choose'+sep+param2,nil);
      ch.Chat.SetCryptState(csInitialising);
      ch.state := csStart;
      ch.ConnectionBirthTime := Gettickcount;
      ch.tmrStartTimeOut.Enabled := true;
    end else begin
      ch.Param2 := param2;
      ch.tmrWaitWithConnectionReset.Interval := BLOCK_RESET_TIME+1000-(Gettickcount-ch.ConnectionBirthTime);
      ch.tmrWaitWithConnectionReset.OnTimer := cbTmrSendaIChoose;
      ch.tmrWaitWithConnectionReset.Enabled := true;
    end;
  end;
end;

function TCryptLayer.SupportedVersions: string;
begin
  result := '1';  //+sep+'2'+sep+'3'+....
end;

function TCryptLayer.ChooseVersion(Versions:string): string;
var
  stoken:TStringTokenizer;
  i,max:integer;
begin
  stoken := TStringTokenizer.Create(Versions);
  try
    stoken.SetTrenner(sep);
    max := 1;
    while stoken.StillAToken do begin
      i := StrToIntDef(stoken.NextToken,1);
      if i > max then
        max := i;
    end;
    result := IntToStr(max);
  finally
    stoken.destroy;
  end;
end;

function TCryptLayer.NewInMessage(msg: string; ChatDistri: TChatDistri): string;
var
  i: Integer;
  ch: PChatItem;
  s: string;
  param1: string;
  param2: string;
  msgpart: string;
  res: string;
  stoken: TStringTokenizer;
  stkn: TStringTokenizer;
  Version: Integer;
  keylib: TCryptKeyLib;
begin
  result := '';
  stkn := TStringTokenizer.Create(msg);
  try
    stkn.SetTrenner(#$D#$A);
    while stkn.StillAToken do
    begin
      msgpart := stkn.NextToken;
      s := GetPrefix(msgpart);
      i := SearchChat(ChatDistri);
      if (s = 'crypt') then
      begin
        res := '';
        if (i >= 0) then
        begin
          ch := ChatList[i];
          Delete(msgpart, 1, Length(s) + 2);
          stoken := TStringTokenizer.Create(msgpart);
          try
            stoken.SetTrenner(sep);
            param1 := stoken.NextToken;
            param2 := stoken.NextToken;
          finally
            stoken.Free;
          end;
          case ch.state of
            csNone:
              begin
                ch.Chat.SetCryptState(csInitialising);
                s := GetPrefix(param1);
                delete(s,5,length(s)); //make out of 'prot1' or 'proto2' etc to 'proto'
                if s = 'prot' then
                begin
                  ch.Initiator := true;
                  SendStart(ch);
                end
                else
                begin
                  if not ch.Initiator then
                  begin
                    if param1='start' then
                    begin
                      SendIChoose(ch,param2);
                    end;
                  end;
                end;
              end;
            csStart:
              begin
                if ((param1='i_choose') and ch.Initiator) or ((param1='lets_use') and not ch.Initiator) then begin
                  if ((param1='i_choose') and ch.Initiator) then begin
                    ch.Chat.SendMessage('{crypt}lets_use'+sep+param2,nil);  //Initiator sends to rcvr lets use protocoll 1
                  end;
                  ch.tmrStartTimeOut.Enabled := false;
                  Version := StrToIntDef(param2,1);
                  case Version of
                  1:  begin
                        if ch.protocoll = nil then begin
                          if (ch.Chat.GetNetType = ntJabber) then
                            keylib := KeyLibjabber
                          else if ch.Chat.GetNetType = ntNobraNet then
                            keylib := KeyLibNobra;
                          ch.protocoll := TCryptProtocollVersion1.create(self,ch.Chat,ch.Initiator,keylib);
                        end;
                        ch.state := csProtocollStarted;
                      end;
                  end;
                end;
              end;
            csProtocollStarted:
              begin
                s := GetPrefix(param1);
                delete(s,5,length(s)); //make out of 'prot1' or 'proto2' etc to 'proto'
                if s = 'prot' then begin
                  s := GetPrefix(param1);
                  if s = 'prot1' then begin
                    if ch.protocoll is TCryptProtocollVersion1 then begin
                      s := msgpart;
                      delete(s,1,pos('}',s));
                      res := result+ch.protocoll.NewInMessage(s,ch);
                    end else
                      res := msgpart;
                  end;
                end else begin
                  if param1='start' then begin
                    ch.Initiator := false;
                    if ch.protocoll <> nil then begin
                      if ch.protocoll is TCryptProtocollVersion1 then begin
                        (ch.protocoll as TCryptProtocollVersion1).destroy;
                      end else
                        ch.protocoll.destroy;
                      ch.protocoll := nil;
                    end;
                    SendIChoose(ch,param2);

                  end else begin
                    res := msgpart;
                  end;
                end;
              end;
            end;
        end;
      end
      else
      begin
        if ChatDistri.GetCryptState <> csInitialising then
          ChatDistri.SetCryptState(csNoEncryption);
        res := msgpart;
      end;
      result := result + res;
      if (res <> '') then
        result := result+#$D#$A;
    end;
    delete(result,length(result)-1,2);
    if result = '' then
    begin
    end;
  finally
    stkn.Free;
  end;
end;

function TCryptLayer.NewOutMessage(msg: string; ChatDistri: TChatDistri): string;
var
  i:integer;
  ch:PChatItem;
begin
 i := SearchChat(ChatDistri);
 result := msg;
 if i > -1 then begin
  ch := ChatList[i];
  if ch.state = csProtocollStarted then begin
    if ch.protocoll <> nil then
      result := ch.protocoll.NewOutMessage(msg,ch);
    end;
  end;
end;







procedure TCryptLayer.SetToWantedCrypt(CryptState: TCryptState;ChatDistri:TChatDistri);
var
  i:integer;
  ch:PChatItem;
begin
 i := SearchChat(ChatDistri);
 if i > -1 then begin
  ch := ChatList[i];
  if ch.state = csProtocollStarted then begin
    if ch.protocoll <> nil then begin
      ch.protocoll.SetToWantedCrypt(CryptState);
    end;
  end else begin
    if (CryptState <> csNoEncryption) and (ch.Initiator) then begin
      SendStart(ch);
    end;
  end;
 end;
end;

procedure TCryptLayer.PartnerGotOffline(ChatDistri: TChatDistri);
var
  i:integer;
  ch:PChatItem;
begin
 i := SearchChat(ChatDistri);
 if i > -1 then begin
  ch := ChatList[i];
  if ch.state = csProtocollStarted then begin
    if ch.protocoll <> nil then
      ch.protocoll.PartnerGotOffline;
    end;
  end;
end;


function TCryptLayer.getKeyLibRecords: string;
begin
  result := KeyLibjabber.getKeyLibRecords('Jabber');
  if result <> '' then
    result := result+sep;
  result := result+KeyLibNobra.getKeyLibRecords('Nobra');
end;

procedure TCryptLayer.DeleteKeyLibRecords(Extra, PartnerID: string);
begin
  extra := LowerCase(extra);
  if extra='jabber' then begin
    KeyLibjabber.DelKey(PartnerID);
  end else if extra = 'nobra' then begin
    KeyLibNobra.DelKey(PartnerID);
  end;
end;

procedure TCryptLayer.SetKeyLibPW(PW: string);
begin
  KeyLibjabber.SetPW(pw);
  KeyLibNobra.SetPW(pw);
end;



{ TCryptProtocol }

constructor TCryptProtocol.create(Layer:TCryptLayer;Chat:TchatDistri;IsInitiator:boolean;KeyLib:TCryptKeyLib);
begin
  inherited create;
  self.Layer := Layer;
  self.chat := chat;
  self.IsInitiator:= IsInitiator;
  self.KeyLib := KeyLib;

end;

destructor TCryptProtocol.destroy;
begin
  inherited destroy;
end;

function TCryptProtocol.NewInMessage(msg: string;ch:PChatItem):string;
begin
  result := '';
  if self is TCryptProtocollVersion1 then
    result := (self as TCryptProtocollVersion1).NewInMessage(msg,ch);
end;

function TCryptProtocol.NewOutMessage(msg: string; ch: PChatItem): string;
begin
  if self is TCryptProtocollVersion1 then
    result := (self as TCryptProtocollVersion1).NewOutMessage(msg,ch)
  else
    result := msg;
end;

procedure TCryptProtocol.PartnerGotOffline;
begin
  if self is TCryptProtocollVersion1 then
    (self as TCryptProtocollVersion1).PartnerGotOffline
end;

procedure TCryptProtocol.SetToWantedCrypt(CryptState: TCryptState);
begin
  if self is TCryptProtocollVersion1 then
    (self as TCryptProtocollVersion1).GoToCryptState(CryptState);
end;

{ TCryptProtocollVersion1 }

procedure TCryptProtocollVersion1.NewSessionAndSentPublicData(SendwithGandP:boolean;g,p:string);
var
  //c: byte;
  PubKey,gBuf,pBuf: array[0..(KeySizeProt1 div 8)-1] of char;
  TxtBuf: array[0..(KeySizeProt1 div 4)] of char;
  i: Integer;
  n: Integer;
  psize: Integer;
  gsize: Integer;
  msg: string;
begin
  for i := 0 to high(PubKey) do
  begin
    PubKey[i]  := #0;
    gBuf[i]  := #0;
    pBuf[i]  := #0;
  end;
  i := sizeof(PubKey);
  psize := i;
  gsize := i;
  if not SendwithGandP then
  begin
    gsize := hextobin(PCHAR(g),gBuf,i);
    psize := hextobin(PCHAR(p),pBuf,i);
    n:=1;
  end
  else
    n := 2;
  for i := 0 to high(TxtBuf) do TxtBuf[i] := #0;
  SessionID := DH_NewSession(@PubKey,i,@pBuf,psize,@gBuf,gsize,KeySizeProt1,n);
  BinToHex(PubKey,TxtBuf,i);
  TxtBuf[high(TxtBuf)]:=#0;
  msg := TxtBuf;
  if SendwithGandP then
  begin
    for i := 0 to high(TxtBuf) do TxtBuf[i] := #0;
    BinToHex(pBuf,TxtBuf,psize);
    TxtBuf[high(TxtBuf)]:=#0;
    DHpParam := TxtBuf;
    msg :=  msg +';'+TxtBuf+';';
    for i := 0 to high(TxtBuf) do TxtBuf[i] := #0;
    BinToHex(gBuf,TxtBuf,gsize);
    TxtBuf[high(TxtBuf)]:=#0;
    DHgParam := TxtBuf;
    msg := msg +TxtBuf;
  end;
  if AuthState = cs1None then
    msg := MakeProtMsg('keyparams'+sep+msg,plAll)
  else
    msg := 'keyparams'+sep+msg;
  sendCntrMsg(msg);
  DHState := cs1DHPubdhKeySent;
end;

procedure TCryptProtocollVersion1.GenerateDHKey(PubKey: string);
var
  //r: Integer;
  i: Integer;
  //s: string;
  pubSize: Integer;
  PubKeyBuf: array[0..(KeySizeProt1 div 8)-1]of char;
//  key:array[0..(KeySizeProt1 div 8)-1]of char;
//  keytxt:array[0..(KeySizeProt1 div 4)-1]of char;
//  keyout:TStringList;
begin
  pubSize := hextobin(PCHAR(PubKey),PubKeyBuf,sizeOf(PubKeyBuf));
  for i := 0 to high(DHResult) do DHResult[i] := #0;
  i := KeySizeProt1 div 8;
  //r :=
  DH_ComputeKey(SessionID,@PubKeyBuf,pubSize,@DHResult,i);

 { LbRijndael.SetKey(key);
  for i := 0 to high(key) do begin
    MyDHKey[i] := key[i];
    key[i] := #0;
  end;     }
end;

procedure TCryptLayer.TestDH();
var
  //c: Byte;
  a,b,ra,rb,p,g: array[0..(KeySizeProt1 div 8)-1] of Byte;
  SessionIDa,SessionIDb,i,m,n,psize,gsize: Integer;
begin
  for i := 0 to high(a) do
  begin
    a[i]  := 0;
    b[i]  := 0;
    ra[i] := 0;
    rb[i] := 0;
    p[i]  := 0;
    g[i]  := 0;
  end;
  Randomize;
  i := sizeof(a);
  psize := i;
  gsize := i;
  SessionIDa := DH_NewSession(@a,i,@p,psize,@g,gsize,256,2);
  SessionIDb := DH_NewSession(@b,i,@p,psize,@g,gsize,256,1);
  i := 32;
  M := DH_ComputeKey(SessionIDa,@b,i,@ra,i);
  if m=0 then begin end;
  i := 32;
  n := DH_ComputeKey(SessionIDb,@a,i,@rb,i);
  if n=0 then begin end;
end;

constructor TCryptProtocollVersion1.create(Layer:TCryptLayer;Chat:TchatDistri;IsInitiator:boolean;KeyLib:TCryptKeyLib);
begin
  inherited Create(layer,Chat,IsInitiator,KeyLib);
  keyChangeRunningTime := 0;
  SendAfterKeyChanged := '';
  ForceToStrongAuth := false;
  KeyChangetimer := TTimer.Create(nil);
  KeyChangetimer.OnTimer := cbKeyChange;
  KeyChangetimer.Enabled := false;
  KeyChangetimer.Interval := 1000;
  CipherWithAuth := true;
  AskedQuestion := '';
  DHpParam := '';
  DHgParam := '';
  justSentCntrlMsg := false;
  cryptques := nil;
  LbRijndael := TLbRijndael.Create(nil);
  LbRijndael.KeySize := ks256;
  LbRijndael.CipherMode := cmCBC;
  if KeySizeProt1 = 256 then
    LbRijndael.KeySize := ks256
  else if KeySizeProt1 = 192 then
    LbRijndael.KeySize := ks192
  else if KeySizeProt1 = 128 then
    LbRijndael.KeySize := ks128;
  AuthState := cs1None;
  DHState := cs1DhNone;
  if IsInitiator then begin

  end else begin
    NewSessionAndSentPublicData(true,'','');
  end;
end;



destructor TCryptProtocollVersion1.destroy;
var
  i:integer;
  key: array[0..(KeySizeProt1 div 8)-1] of Byte;
begin
  if cryptques <> nil then
    cryptques.Close;
  KeyChangetimer.Free;
  DHState := cs1DHNone;
  AuthState := cs1none;
  for i := 0 to high(key) do key[i] := 0;
  for i := 0 to high(mydhkey) do  mydhkey[i] := #0;
  LbRijndael.SetKey(key);
  LbRijndael.Free;
  inherited destroy;
end;

procedure TCryptProtocollVersion1.sendCntrMsg(msg:string);
begin
  justSentCntrlMsg := true;
  chat.SendMessage(msg,nil);
end;

function TCryptProtocollVersion1.Decrypt(msg: string): string;
begin
  result := DecryptRJDLProt1(msg,LbRijndael);
end;

function TCryptProtocollVersion1.Encrypt(msg: string): string;
begin
  result := EncryptRJDLProt1(msg,LbRijndael);
end;

procedure TCryptProtocollVersion1.SendSKState;
var
  s:string;
begin
  if CipherWithAuth then begin
    if KeyLib.KeyExists(chat.GetUserIDwoPortNum) then
      s:= 'ihavesk'+sep+'yes'
    else begin
      s:= 'ihavesk'+sep+'no';
    end;
    sendCntrMsg(s);
    AuthState:=cs1SKDBStateSent;
    chat.SetCryptState(csWaitingForQues);
  end;
end;

function TCryptProtocollVersion1.Do_cs1SKDBStateSent(res,param1,param2:string):string;
begin
  result := res;
  if (param1='ihavesk') then begin
    if (param2='yes') and (KeyLib.KeyExists(chat.GetUserIDwoPortNum)) then begin
      GenerateSKKey(KeyLib.GetSessionKeyHex(chat.GetUserIDwoPortNum));
    end else begin
      if not ForceToStrongAuth then begin
        resettodh;
      end else begin
        if not IsInitiator then begin
          if cryptques = nil then
            cryptques := Tfrm_CryptQuestion.CreateQuestion(application.MainForm,self);
        end;
      end;
    end;
  end else if (param1 = 'skques') then begin
    if cryptques = nil then
      cryptques := Tfrm_CryptQuestion.CreateAnswer(application.MainForm,self,param2,false);
    AskedQuestion := param2;
  end;
  //result := '';
end;

procedure TCryptProtocollVersion1.ProcessDHExchange(msg:string);
var
  param1: string;
  param2: string;
  pubkey: string;
  //s: string;
  stoken: TStringTokenizer;
  //i: Integer;
begin
  stoken := TStringTokenizer.create(msg);
  try
    stoken.SetTrenner(sep);
    param1 := stoken.NextToken;
    param2 := stoken.NextToken;
  finally
    stoken.Free;
  end;
  case DHState of
    cs1DHNone:
      begin
        if (param1='keyparams') and ((IsInitiator) or (AuthState = cs1DHing)) then begin
          stoken := TStringTokenizer.create(param2);
          try
            stoken.SetTrenner(';');
            pubkey := stoken.NextToken;
            if AuthState = cs1none then begin
              DHpParam := stoken.NextToken;
              DHgParam := stoken.NextToken;
            end;
          finally
            stoken.Free;
          end;
          NewSessionAndSentPublicData(false,DHgParam,DHpParam);
          DHState := cs1DHPubdhKeySent;
          GenerateDHKey(pubkey);
          DHState := cs1dhKeyGenerated;
        end;
      end;
    cs1DHPubdhKeySent:
      begin
        if (param1='keyparams') and ((not IsInitiator) or (AuthState = cs1DHing)) then begin
          stoken := TStringTokenizer.create(param2);
          try
            stoken.SetTrenner(';');
            pubkey := stoken.NextToken;
          finally
            stoken.Free;
          end;
          GenerateDHKey(pubkey);
          DHState := cs1dhKeyGenerated;
        end;
      end;
  end;
end;

function TCryptProtocollVersion1.NewInMessage(msg: string;ch:PChatItem): string;
var
  param1: string;
  param2: string;
  //pubkey: string;
  //p: string;
  //g: string;
  s: string;
  md5is: string;
  md5should: string;
  stoken: TStringTokenizer;
  i: Integer;
  //m: Integer;
  //c: Byte;
  IsCntrl: Boolean;
  keytmp: array[0..(KeySizeProt1 div 8)-1]of byte;
  keytxt: array[0..(KeySizeProt1 div 4)-1]of char;
  //keyout: TStringList;

  procedure SendUnsentMsgs();
  var
    stoken: TStringTokenizer;
  begin
    if (SendAfterKeyChanged <> '') then
    begin
      stoken := TStringTokenizer.create(SendAfterKeyChanged);
      try
        stoken.SetTrenner(msgsep);
        while stoken.StillAToken do
          chat.SendMessage(stoken.NextToken,nil);
      finally
        stoken.Free;
      end;
      SendAfterKeyChanged := '';
    end;
  end;

  function TestIfCntrl(var s: string): Boolean;
  var
    t:string;
  begin
    t := GetPrefix(s);
    result :=  t = 'cntr';
    if result then
      delete(s,1,pos('{cntr}',s)+length('{cntr}')-1)
    else if t='msg' then
      delete(s,1,pos('{msg}',s)+length('{msg}')-1)
    else begin
      delete(s,1,pos('{msg}',s)+length('{msg}')-1);//shouldnt stop here. if yes, great! trace it and you found a bug!
    end;
  end;

begin
  //IsCntrl := false;
  result := Msg;

 // cs1DHNone,cs1DHPubdhKeySent,cs1dhKeyGenerated
   case AuthState of
    cs1none:    begin
                          ProcessDHExchange(msg);
                          if DHState = cs1dhKeyGenerated then begin
                            AuthState := cs1DHEncry;
                            for i := 0 to high(MyDHKey) do begin
                              MyDHKey[i] := DHResult[i];
                              DHResult[i] := '_';
                            end;
                            LbRijndael.SetKey(MyDHKey);
                            DHState := cs1DHNone;
                            chat.SetCryptState(csWeak);
                            SendSKState;
                          end;
                          result := '';
                        end;

    cs1DHEncry,cs1SKDBStateSent,cs1AuthQuestionSent,cs1SKGenerated:
                        begin
                          result := Decrypt(msg);
                          delete(result,pos(END_INDICATOR,result),length(result));    //For Sending longer messages if you want more entropy
                        end;



  end;
  IsCntrl :=  TestIfCntrl(result);
  if CipherWithAuth then begin
    if (AuthState=cs1DHEncry) or (AuthState=cs1SKDBStateSent)or (AuthState=cs1AuthQuestionSent)  then begin
      stoken := TStringTokenizer.create(result);
      try
        stoken.SetTrenner(sep);
        param1 := stoken.NextToken;
        param2 := stoken.NextToken;
      finally
        stoken.Free;
      end;
    end;
    case AuthState of
      cs1SKDBStateSent:
        begin
          Do_cs1SKDBStateSent(result,param1,param2);
          if not IsCntrl then
            result := '';
        end;
      cs1AuthQuestionSent:
        begin
          s := GetPrefix(result);
          if s = 'crypt' then
            delete(result,1,pos('{crypt}',result)+length('{crypt}')-1);
          s := GetPrefix(result);
          delete(result,1,pos('{prot1}',result)+length('{prot1}')-1);
          if s = 'prot1' then begin
            if result='sknotestablished' then begin
             // result := '';
            end;
            if result='skestablished' then begin
              //result := '';
            end;
          end;
        end;
      cs1SKGenerated:
        begin
          result := Decrypt(msg);
          md5is := result;
          delete(md5is,33,length(md5is));
          md5should := KeyLib.GetSessionMD5(chat.GetUserIDwoPortNum);
          delete(result,1,32);
          if md5is <> md5should then begin

            AuthState := cs1SKDBStateSent;
            chat.SetCryptState(csWaitingForQues);
            LbRijndael.SetKey(mydhkey);
            if (AskedQuestion <> '') then
              Do_cs1SKDBStateSent(result,'skques',AskedQuestion)
            else
              Do_cs1SKDBStateSent(result,'ihavesk','no');
            result := '';
          end else begin
            chat.SetCryptState(csAuthenticated);
            sendCntrMsg(MakeProtMsg('skestablished',plAll));
            AuthState := cs1SKEstablished;
            SendUnsentMsgs;

            if IsInitiator then begin
              KeyChange;
            end;
            KeyChangetimer.Enabled := true;
            keyChangeRunningTime := 0;
          end;
        end;
      cs1SKEstablished,cs1DHing:
        begin
          result := Decrypt(msg);
          delete(result,pos(END_INDICATOR,result),length(result));
          md5is := result;
          delete(md5is,33,length(md5is));
          md5should := KeyLib.GetSessionMD5(chat.GetUserIDwoPortNum);
          delete(result,1,32);
          if md5is <> md5should then begin
            result := 'ENCRYPTION ERROR!';
            result := '';
            LbRijndael.GetKey(keytmp);
            LbRijndael.SetKey(MyDHKey);
            result := Decrypt(msg);
            LbRijndael.SetKey(keytmp);
            for i := 0 to high(keytmp) do keytmp[i] := 0;
            IsCntrl :=  TestIfCntrl(result);
            if not IsCntrl then begin
              //result := 'ENCRYPTION ERROR!';
              result := '';
            end;
          end else
            IsCntrl :=  TestIfCntrl(result);

          if (AuthState = cs1DHing) and IsCntrl then
          begin
            if IsCntrl then
            begin
              ProcessDHExchange(result);
              if DHState = cs1dhKeyGenerated then
              begin
                chat.SetCryptState(csAuthenticated);
                AuthState := cs1SKEstablished;
                DHState := cs1DHNone;
                LbRijndael.GetKey(keytmp);
                BinToHex(@DHResult[0],keytxt,sizeof(DHResult));
                //keyout := TStringList.Create;
                //try
                //  if fileexists('keyout.txt') then
                //    keyout.loadfromfile('keyout.txt');
                //  keyout.add('rcvedpublic:'+PubKey+' private:'+keytxt);
                //  keyout.SaveToFile('keyout.txt');
                //finally
                //  keyout.Free;
                //end;
                XORBuffers(DHResult,keytmp,sizeof(DHResult));
                LbRijndael.SetKey(DHResult);
                KeyLib.ModifyKeyBuf(chat.GetUserIDwoPortNum,DHResult,sizeof(DHResult));
                for i := 0 to high(DHResult) do begin
                  DHResult[i] := '_';
                  keytmp[i] := 0;
                end;
                SendUnsentMsgs;
              end;
            end;
          end;
        end;
    end;
  end;

  if IsCntrl then
  begin
    if result = 'junk' then
    begin
    end
    else if result = 'resettodh' then
    begin
      resettodh;
    end
    else if result = 'gotoauthmode' then
    begin
      GoToAuthMode;
    end
    else if result = 'letsdodh' then
    begin
      if (AuthState = cs1SKEstablished) then
      begin
        chat.SetCryptState(csChangingKey);
        AuthState := cs1DHing;
        NewSessionAndSentPublicData(false,DHgParam,DHpParam);
        keyChangeRunningTime := KEYCHANGE_INTERVAL div 2;
      end;
    end;
    result := '';
  end;
end;

procedure TCryptProtocollVersion1.KeyChange();
begin
  if (AuthState = cs1SKEstablished) then
  begin
    chat.SetCryptState(csChangingKey);
    AuthState := cs1DHing;
    sendCntrMsg('letsdodh');
  end;
end;

procedure TCryptProtocollVersion1.cbKeyChange(Sender: TObject);
begin
  if keyChangeRunningTime > KEYCHANGE_INTERVAL then
  begin
    KeyChange;
    keyChangeRunningTime := 0;
  end;
  inc(keyChangeRunningTime);
end;

function TCryptProtocollVersion1.NewOutMessage(msg: string; ch: PChatItem): string;
{var
  md5is: string;
  md5should: string;
  i: Integer;
  m: Integer;}

  function RecordMsgForMaybeNotSendingYet(msg: string): string;
  begin
    if (AuthState = cs1DHing) or (AuthState = cs1SKGenerated) or (AuthState = cs1SKDBStateSent) or (AuthState = cs1AuthQuestionSent) then begin
      if SendAfterKeyChanged <> '' then
        SendAfterKeyChanged := SendAfterKeyChanged+ msgsep;
      SendAfterKeyChanged := SendAfterKeyChanged+msg;
      result := '';
    end else
      result := msg;
  end;

begin
  result := '';
  if (AuthState = cs1DHEncry) or (AuthState = cs1SKDBStateSent) or (AuthState = cs1AuthQuestionSent) then begin
    if justSentCntrlMsg then
      msg := '{cntr}'+msg
    else
    begin
      msg := '{msg}'+msg;
      msg := RecordMsgForMaybeNotSendingYet(msg);
    end;
    if msg <> '' then
    begin
      result := Encrypt(msg);
      result := MakeProtMsg(result,plAll);
    end;
  end else if (AuthState = cs1SKGenerated) or (AuthState = cs1SKEstablished) or (AuthState = cs1DHing) then begin
    if justSentCntrlMsg then
      msg := '{cntr}'+msg
    else begin
      msg := '{msg}'+msg;
      msg := RecordMsgForMaybeNotSendingYet(msg);
    end;
    msg := KeyLib.GetSessionMD5(chat.GetUserIDwoPortNum)+msg;
    if msg <> '' then begin
      result := Encrypt(msg);
      result := MakeProtMsg(result,plAll);
    end;
  end else
    result := msg;
  justSentCntrlMsg := false;
end;





function TCryptProtocollVersion1.MakeProtMsg(msg: string;level:TProtLevel):string;
begin
  if level = plAll then
    result := '{crypt}{prot1}'+msg
  else if level = pljustProt1 then
    result := '{prot1}'+msg;
end;

procedure TCryptProtocollVersion1.SendQuestion(Question: string);
begin
  AskedQuestion := Question;
  Question := 'skques'+sep+Question;
  sendCntrMsg(Question);
  AuthState := cs1AuthQuestionSent;
end;

function TCryptProtocollVersion1.KeyStrength(weakkey: string): string;
begin
  result := KeyStrengthProt1(weakkey,KEY_STRENGTH_ROUNDS)
end;

procedure TCryptProtocollVersion1.SetSecretAnswerMD5(secretAnswer: string);
var
  key: array[0..(KeySizeProt1 div 8)-1]of char;
  keytxt: array[0..(KeySizeProt1 div 4)]of char;
  i: Integer;
  //n: Integer;
  s: string;
begin
  s := KeyStrength(secretAnswer);
  for i := 0 to high(keytxt) do
  begin
    if length(s) > i then
      keytxt[i] := s[i+1]
    else
      keytxt[i] := #0;
  end;
  for i := 0 to high(key) do key[i] := #0;
  //i :=
  HexToBin(keytxt,key,sizeof(key));
  KeyLib.ModifyKeyBuf(chat.GetUserIDwoPortNum,key,sizeof(key));
  GenerateSKKey(s);
  //chat.SendMessage(MakeProtMsg('sktest'),nil);
end;

procedure TCryptProtocollVersion1.GenerateSKKey(SessionKey: string);
var
  key: array[0..(KeySizeProt1 div 8)-1]of char;
  sk: array[0..(KeySizeProt1 div 8)-1]of byte;
  dhkey: array[0..(KeySizeProt1 div 8)-1]of char;
  keytxt: array[0..(KeySizeProt1 div 4)]of char;
  i: Integer;
  n: Integer;
begin
  for i := 0 to high(keytxt) do
  begin
    if length(SessionKey) > i then
      keytxt[i] := SessionKey[i+1]
    else
      keytxt[i] := #0;
  end;
  for i := 0 to high(key) do key[i] := #0;
  //i :=
  HexToBin(keytxt,key,sizeof(key));
  for n := 0 to high(key) do  sk[n] := ord(key[n]);
  LbRijndael.GetKey(dhkey);
  XORBuffers(dhkey,sk,sizeof(sk));
  LbRijndael.SetKey(dhkey);
  AuthState := cs1SKGenerated;
  sendCntrMsg(MakeProtMsg('sktest',plAll));
end;

procedure TCryptProtocollVersion1.UnregisterCryptQuesWindow;
begin
  cryptques := nil;
end;

procedure TCryptProtocollVersion1.GoToCryptState(WantedState: TCryptState);
begin
  if WantedState = csweak then begin
    sendCntrMsg('resettodh');
    resettodh;
    sendCntrMsg('resettodh');
  end;
  if WantedState = csAuthenticated then begin
    sendCntrMsg('gotoauthmode');
    GoToAuthMode;
  end;
end;

procedure TCryptProtocollVersion1.resettodh;
begin
    LbRijndael.SetKey(mydhkey);
    chat.SetCryptState(csWeak);
    if cryptques <> nil then
      cryptques.Close;
    CipherWithAuth := false;
    AuthState := cs1DHEncry;
end;

procedure TCryptProtocollVersion1.GoToAuthMode;
begin
    CipherWithAuth := true;
    ForceToStrongAuth := true;
    SendSKState;
end;



procedure TCryptProtocollVersion1.PartnerGotOffline;
begin
 //
end;

end.
